home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1994 November / Cd Ware (Nro. 2) - Epimundo.iso / DOS / UD / CRUSH.ZIP / UNCR061.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1994-06-01  |  12.8 KB  |  298 lines

  1. (*
  2.    UNCRUSH 0.61  -  Public Release
  3.    Designed and created by Bill Davidson
  4.  
  5. NOTE : Please view the documentation. This program will not execute
  6.        properly without a preset file name.
  7.  
  8.  This is Freeware. Please distribute.
  9.  
  10. *)
  11.  
  12.  
  13. uses dos,crt;              { Standard procedure that I always add... }
  14.  
  15. const VIIImax = 100;
  16.       VIImax = 100;
  17.       VImax = 100;
  18.       Vmax = 100;          { Setting the array maximums }
  19.       IVmax = 100;
  20.       IIImax = 100;
  21.       theoffset = 145;     { This is a length to push the code character
  22.                              into the extended ASCII set }
  23.  
  24. type  VIIIarray = array[1..VIIImax] of string[8];
  25.       VIIarray = array[1..VIImax] of string[7];
  26.       VIarray = array[1..VImax] of string[6];
  27.       Varray = array[1..Vmax] of string[5];    { Defining the arrays }
  28.       IVarray = array[1..IVmax] of string[4];
  29.       IIIarray = array[1..IIImax] of string[3];
  30.       asciiarray = array[1..100] of char;
  31.       chrarray = array[1..6] of char;
  32. const
  33.   VIIIlist: VIIIarray = ('        ',' of the ','@       ','--------',' in the ',' pointer','tion of ',' to the ','tructure',
  34.                         'structur','@@~     ','ing the ',' structu','haracter','e of the','lgorithm','characte',' process',
  35.                         'that the',' charact',' that th','@@      ',' program','compress','s of the','rocessor','language',
  36.                         'pointers','algorith','program ',' languag',' can be ',' for the','for the ','ation of','function',
  37.                         ' compres','epresent','@Figure ',' on the ','hat the ',' algorit','represen','entation','mplement',
  38.                         'and the ','ormation','formatio',' the pro',' recursi',' functio',' and the','ubprogra',' represe',
  39.                         'subprogr','ion of t','implemen','ompressi','n of the','on of th','nformati','________','ocessor ',
  40.                         ' example','ructures',' subprog','rom the ',' from th','from the','t of the','with the','pression',
  41.                         'of the s',' impleme','@@@@@@@@',' with th','position','variable','ould be ',' number ','mpressio',
  42.                         'pointer ','nstructi','ictionar','omponent',' is the ','dictiona','ctionary','putation','consider',
  43.                         'componen','processo','ointers ','ed in th','ith the ','computat','mputatio','umber of','truction',
  44.                         'database');
  45.  
  46.   VIIlist: VIIarray = ('       ',' of the','of the ','@      ','_______','in the ',' in the',' which ','to the ',' to the',
  47.                        'program','ion of ','pointer','tion of',' pointe','ing the','tructur','ructure','ng the ','@@     ',
  48.                        '@@~    ','@~     ','s that ','e of th',' the co','process','present','at the ','aracter','lgorith',
  49.                        'gorithm','anguage','and the','that th','ompress',' the st','hat the','can be ','s of th',' that t',
  50.                        'e that ',' string','ations ','Figure ','rogram ','or the ','for the',' for th',' scheme',' can be',
  51.                        'on the ','ointers',' the pr','ocessor','nd the ',' follow','@Figure',' on the','ation o',' number',
  52.                        ' to be ',' and th','unction',' compre','recursi','the pro',' the re','ntation','nstruct','.  The ',
  53.                        'mplemen',' sub i%','plement',' other ','formati','tional ','tation ','rmation',' comput',' recurs',
  54.                        'n of th','es the ','rom the',' there ','with th','t of th','from th',' would ',' repres','on of t',
  55.                        '-------',' first ','example','@@@@@@@',' subpro','mpressi','.@This ',' from t','cessor ','ould be');
  56.  
  57.    VIlist: VIarray = ('      ',' of th',' that ','f the ',' the s','@     ','ation ',' the c','s the ','in the',' this ',
  58.                      'e the ',' in th','which ','______',' point','t the ',' with ','struct','to the',' which',' the p',
  59.                      'rogram','o the ',' to th','@@    ','ion of','tions ','ing th','tion o','pointe','on of ','ointer',
  60.                      '.@The ','rocess','ations','tation','s are ','at the','ction ',', and ','s that',' the f','s and ',
  61.                      'ructur',' proce','the co','ucture','r the ',' have ','~     ','g the ','d the ','@~    ','e of t',
  62.                      ' will ',' the t','nd the','string',' the l','and th','lement','ed by ','ed to ',' struc','presen',
  63.                      ' the a','ed in ','resent','e that',' the r','other ',' the r','other ',' the n',' sub i','hat th',
  64.                      'racter','gorith','orithm','that t','can be','the st','ection','  The ','or the',' other','nguage',
  65.                      'mpress','s of t',' the o','there ',' the e','for th','an be ','on the','Figure',' of a ','------',
  66.                      '. The ');
  67.  
  68.   Vlist: Varray = ('     ',' the ',' and ','tion ','ation','of th',' of t',' that','f the','that ','@    ','n the',' sub ',
  69.                    'ction','s of ',' for ','the s',' comp','s the',' are ','the c','e the','e of ','tions',' with','in th',
  70.                    't the','ing t',' this','this ','which','with ',' in t','point',' the@','inter','to th','hich ','_____',
  71.                    'the p','ther ','truct','o the','.@The','@The ',' to t','struc','@the ','here ','s to ','ion o','ions ',
  72.                    't of ','@and ','@@   ','ting ',' not ','ng th','ogram','ition','n of ','t is ','d the','on of','ement',
  73.                    ' from',' can ','from ','other','ointe',' cont','progr',' of a','s are',' one ','at th','ed in','ding ',
  74.                    'he co','e is ','r the','g the','proce','ocess','d to ',', and','ould ',' is a','cture','s and','the f',
  75.                    ', the','ing a','nd th',' have','s tha','and t','have ','will ',' The ');
  76.  
  77.   IVlist: IVarray = ('    ',' the','the ',' of ','tion','ing ','and ',' to ',' and',' is ','ion ',' in ','that','f th',' tha',
  78.                      'atio','hat ','of t','n th',' sub','@   ','s th',' for','e th','his ',' pro','ther',' com','for ',' be ',
  79.                      ' con','sub ','s of','he s','comp','The ','are ',' are','he c','t th','with','ent ','e of','ions',' thi',
  80.                      'e co','ment','.@Th','in t','ted ','inte','@the','nter','this','@The',' wit','ng t','ter ','here',' as ',
  81.                      'mple','o th','her ','ith ','pres','@and',' str','hich','ting','to t','oint',' not','d th','he p','the@',
  82.                      'ere ','ding','ring',' by ','s a ',' it ','____','ich ',' whi','s to','s in','cess','form','s an','t th',
  83.                      'is a','gram','ed t','ture','one ','t of',' poi','t is','----','oice');
  84.  
  85.   IIIlist: IIIarray = ('   ',' th','the','he ',' of','of ','ing','ion','is ','and','tio',' an','nd ',' in','ed ',' to','to ',
  86.                        'ng ',' co','er ','on ','es ',' a ','re ',' is','ent','in ','s a','e t','or ','ter',' re',' su','at ',
  87.                        's t','for',' be','ati','@@~','hat','tha','e s','e a','n t','al ','her','f t','res','pro','e c',' fo',
  88.                        ' pr','s o',' st','e o','as ','sub','.  ','all','en ','on ','con','are','ess','his','ly ','e i','The',
  89.                        'ch ',' no','@  ','t t','ith','omp','ons','int','nte','ll ',' ar','ere',' de','cti','be ','ver','nt ',
  90.                        'st ','d t','ers',' wi',' wh','str','e p','nce','ts ',' ma','ate','@th','thi','---','. T');
  91.  
  92.   chrlist: chrarray = (chr(1),chr(2),chr(3),chr(4),chr(5),chr(6));
  93.  
  94.    { Those compose my compression dictionary from which I uncode for }
  95.  
  96.  
  97. var
  98.  f,j : text;
  99.  b5,b4,b6,b7,b8,a5 : integer;
  100.  s : string[160];
  101.  a1,d1 : integer;                     { Defining varibles }
  102.  chra,length1 : integer;
  103.  label endloopa1,startloop,endloop;
  104.  
  105. (********************* Procedures ***************************)
  106.  
  107.   { The start of the engine is at the bottom, below the procedures }
  108.  
  109. procedure gram8;
  110. var
  111.  c1 : string[1];
  112.  c : char;
  113.  a2,d1 : integer;
  114.  a3 : string[8];
  115.  label start8;
  116.  
  117.  begin;
  118.    start8:
  119.     c1 := copy(s,a1+1,1);    { After reaching a header character, it goes
  120.                                to the code character, which is to the right
  121.                                one character. }
  122.     c := c1[1];              { Getting the ASCII character }
  123.     a2 := ord(c);            { Receiving the ordinal value of 'c' }
  124.     a3 := VIIIlist[a2-theoffset];  { Removing the offset number placed during
  125.                                      compression and getting the
  126.                                      cooresponding array string }
  127.     delete(s,a1,2);          { Deleting the header and code characters }
  128.     insert(a3,s,a1);         { Inserting the string where the header
  129.                                character was }
  130.     d1 := 8;                 { Since I put in an 8 character string, the
  131.                                pointer on the line needs to skip that
  132.                                string by advancing 8 characters }
  133.  end;                        { Return to main procedure }
  134.  
  135. (********************* 7 *********************)
  136.  
  137. procedure gram7;
  138. var
  139.  c1 : string[1];
  140.  c : char;
  141.  a2,d1 : integer;
  142.  a3 : string[7];
  143.  label start7;
  144.  
  145.  begin;
  146.   start7:
  147.     c1 := copy(s,a1+1,1);         { Same as 8 }
  148.     c := c1[1];
  149.     a2 := ord(c);
  150.     a3 := VIIlist[a2-theoffset];
  151.     delete(s,a1,2);
  152.     insert(a3,s,a1);
  153.     {goto start7;}
  154.     d1 := 7;
  155.  end;
  156.  
  157. (************************* 6 ************************)
  158. procedure gram6;
  159. var
  160.  c1 : string[1];
  161.  c : char;
  162.  a2,d1 : integer;
  163.  a3 : string[6];
  164.  label start6;
  165.  
  166.  begin;
  167.   start6:
  168.     c1 := copy(s,a1+1,1);
  169.     c := c1[1];
  170.     a2 := ord(c);
  171.     a3 := VIlist[a2-theoffset];
  172.     delete(s,a1,2);
  173.     insert(a3,s,a1);
  174.     {goto start6;}
  175.     d1 := 6;
  176.  end;
  177.  
  178. (************************* 5 *******************************)
  179. procedure gram5;
  180. var
  181.  c1 : string[1];
  182.  c : char;
  183.  a2,d1 : integer;
  184.  a3 : string[5];
  185.  label start5;
  186.  
  187.  begin;
  188.   start5:
  189.     c1 := copy(s,a1+1,1);
  190.     c := c1[1];
  191.     a2 := ord(c);
  192.     {writeln(s,' ',c,' ',a2,' ',a3);}
  193.     a3 := Vlist[a2-theoffset];
  194.     
  195.     delete(s,a1,2);
  196.     insert(a3,s,a1);
  197.     {goto start5;}
  198.     d1 := 5;
  199.  end;
  200.  
  201. (********************** 4 ************************)
  202. procedure gram4;
  203. var
  204.  c1 : string[1];
  205.  c : char;
  206.  a2,d1 : integer;
  207.  a3 : string[4];
  208.  label start4;
  209.  
  210.  begin;
  211.   start4:
  212.     c1 := copy(s,a1+1,1);
  213.     c := c1[1];
  214.     a2 := ord(c);
  215.     a3 := IVlist[a2-theoffset];
  216.     delete(s,a1,2);
  217.     insert(a3,s,a1);
  218.     {writeln('s=',s,'*length1=',length1);}
  219.     {goto start4;}
  220.     d1 := 4;
  221.  end;
  222.  
  223. (************************ 3 **************************)
  224. procedure gram3;
  225. var
  226.  c1 : string[1];
  227.  c : char;
  228.  a2,d1 : integer;
  229.  a3 : string[3];
  230.  label start3;
  231.  
  232.  begin;
  233.   start3:
  234.     c1 := copy(s,a1+1,1);
  235.     c := c1[1];
  236.     a2 := ord(c);
  237.     a3 := IIIlist[a2-theoffset];
  238.     delete(s,a1,2);
  239.     insert(a3,s,a1);
  240.     {goto start3;}
  241.     d1 := 3;
  242.  end;
  243.  
  244. {
  245.         End of the Procedures of Compression
  246. }
  247.  
  248. begin
  249. assign(f,'w.w');             { Assigning 'f' to the coded file }
  250. reset(f);                    { Opening the coded file }
  251. assign(j,'e.e');             { Assigning 'j' to the output file }
  252. rewrite(j);                  { Open 'j' for writing }
  253. while not eof(f) do          { Work until we reach the end of file marker }
  254.  begin                       { Begin looking at a line }
  255.  readln(f,s);                { Read a line }
  256.  d1 := 0;                    { This is a variable that advances the pointer,
  257.                                or a1 }
  258.  length1 := length(s);       { Get the length of the line }
  259.  for chra := 249 to 254 do   { Begin looking for header characters }
  260.    begin
  261.    a1 := 0;                  { This is the pointer that records the position
  262.                                on the line }
  263.    startloop:
  264.    a1 := a1 + 1;             { Advance the pointer to the next character }
  265.    if a1 > length1 then goto endloop;  { Check to see if it has reached the
  266.                                          end of the line }
  267.      begin
  268.      if chr(chra) = s[a1]  then       { If you find the character... }
  269.       begin
  270.       if chr(chra) = s[a1+1] then         {... and it has a twin, then...}
  271.         begin
  272.         delete(s,a1,1);      { Delete the twin }
  273.         goto endloopa1;
  274.         end;
  275.  
  276.         case chra of         { If it doesn't have a double then begin
  277.                                uncoding }
  278.          249: gram8;
  279.          250: gram7;
  280.          251: gram6;
  281.          252: gram5;
  282.          253: gram4;
  283.          254: gram3;
  284.         end;                 { End case }
  285.         a1 := a1 + d1;       { Advance the pointer past the uncoded string }
  286.        end;                  { end "if chr(chra) = s[a1] then" }
  287.      endloopa1:
  288.      length1 := length(s);
  289.      goto startloop;
  290.      endloop:
  291.      end;            { end "for a1 1 to length1 do" }
  292.   end;              { end "for chra 249 to 254 do" }
  293.  
  294.  
  295. writeln(j,s);       { Write the uncoded line to the output file }
  296. end;                { end program }
  297. close(j);           { Save 'j' }
  298. end.